home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / fcache.tcl.z / fcache.tcl
Text File  |  2002-07-08  |  11KB  |  321 lines
  1. #
  2. # fcache.tcl
  3. #
  4. # Folder cache display - a smaller folder display of frequently visted folders.
  5. #
  6. # Copyright (c) 1993 Xerox Corporation.
  7. # Use and copying of this software and preparation of derivative works based
  8. # upon this software are permitted. Any distribution of this software or
  9. # derivative works must comply with all applicable United States export
  10. # control laws. This software is made available AS IS, and Xerox Corporation
  11. # makes no warranty about the software, its performance or its conformity to
  12. # any specification.
  13.  
  14. proc Fcache_Init {} {
  15.     global fcache exmh subFolders
  16.     global mhProfile flist
  17.     set fcache(folders) {}
  18.  
  19.     if {[info exists exmh(newuser)] && [info exists subFolders]} {
  20.     set N [llength [array names subFolders]]
  21.     if {$N <= 2} {
  22.         set fcache(lines) 0
  23.     } elseif {$N < 10} {
  24.         set fcache(lines) 1
  25.     } else {
  26.         set fcache(lines) 2
  27.     }
  28.     }
  29.  
  30.     Preferences_Add "Folder Cache" \
  31. "Exmh can maintain a cache of buttons for recently used folders. Set the cache size to 0 (zero) to disable this feature.  The cache appears as a second display below the main display of folder labels.
  32. The cache is useful if you have lots of folders or a heavily nested folder structure.  If you only have a few lines of folder labels, the cache probably just wastes space." {
  33.     {fcache(lines) fcacheLines 1 {Num cached folder lines}
  34. "Exmh can maintain a cache of buttons for recently used folders.
  35. Set the cache size to 0 (zero) to disable this feature.  The
  36. cache appears as a second display below the main display of
  37. folder labels.  The cache is useful if you have lots of folders
  38. or a heavily nested folder structure.  If you only have a few
  39. lines of folder labels, the cache probably just wastes space." }
  40.     {fcache(sticky) fcacheSticky inbox {Permanently cached folders}
  41. "Set this to the list of folders you always want in the cache." }
  42.     {fcache(stickyOff) fcacheStickyOff OFF {No permanently cached folders}
  43. "The only way to have no permanently cached folders is to set this option."}
  44.         {fcache(dontCache) fcacheDontCache "" {Never cached folders}
  45. "Set this to the list of folders you never want in your cache. Elements
  46. of the list don't have to be actual folders: they can be patterns,
  47. using *, ?, \[a-z] (and \\ to quote those special chars). For instance
  48. */announce will keep softs/exmh/announce as well as sarex/announce out
  49. of the cache."}
  50.         {fcache(sortByName) fcacheSortByName ON {Sort the folders by name}
  51. "Set this to keep the folders sorted by name rather than sorted by LRU in
  52. your cache. Note that it uses the names rather than the nicknames for sorting."}
  53.         {fcache(cacheUnseen) fcacheCacheUnseen ON {Cache the unseen folders}
  54. "Reset this option if you don't want to automatically add the unseen
  55. folders in your cache."}
  56.         {fcache(cacheTarget) fcacheCacheTarget ON {Cache the target folder}
  57. "Reset this option if you don't want to automatically add the target
  58. folder in your cache."}
  59.         {fcache(nicknames) fcacheNickNames ON {Use nicknames in the display}
  60. "Use nicknames in the folder cache display. Very convenient if your folder
  61. structure is deeply nested." }
  62.     }
  63.     trace variable fcache(lines) w FcacheFixupLines
  64.     trace variable fcache(sticky) w FcacheFixupSticky
  65.     trace variable fcache(sortByName) w Fcache_Redisplay
  66.     trace variable fcache(nicknames) w Fcache_Redisplay
  67.  
  68.     # Init the cache and handle various error cases.
  69.  
  70.     if {$fcache(stickyOff)} {
  71.     # Pref_Add will give us "inbox" if the user trys to set
  72.     # the stickly list to zero.  Need this hack.
  73.     set fcache(sticky) {}
  74.     }
  75.  
  76.     if [catch {source $mhProfile(path)/.exmhfcache} msg] {
  77.     set fcache(folders) $fcache(sticky)
  78.     set fcache(LRU) $fcache(sticky)
  79.     }
  80.     set fcache(enabled) [expr $fcache(lines) > 0]
  81.     set fcache(lastLines) $fcache(lines)
  82.  
  83.     if ![info exists fcache(LRU)] {
  84.     set fcache(LRU) $fcache(folders)
  85.     }
  86.     if {[llength $fcache(folders)] != [llength $fcache(LRU)]} {
  87.     set fcache(LRU) $fcache(folders)
  88.     }
  89.     FcacheFixupLines nodisplay
  90. }
  91. proc Fcache_Redisplay { args } {
  92.    Fcache_Display 1
  93. }
  94. proc Fcache_FolderName { folder } {
  95.    global folderNickName nickNameFolders fcache
  96.  
  97.    if {! $fcache(nicknames)} {
  98.       return $folder
  99.    } elseif [info exists folderNickName($folder)] {
  100.       return $folderNickName($folder)
  101.    }
  102.    set nickname {}
  103.    foreach part [Pgp_Misc_Reverse [split $folder "/"]] {
  104.       if {"$nickname" == {}} {
  105.      set nickname "$part"
  106.       } else {
  107.      set nickname "$part/$nickname"
  108.       }
  109.       if [info exists nickNameFolders($nickname)] {
  110.      # there is a potential clash
  111.      set folders $nickNameFolders($nickname)
  112.      if {[lsearch $folders $folder] >= 0} {
  113.         # we have already dealt with this folder before
  114.         if {[llength $folders] == 1} {
  115.            # no name clash
  116.            set folderNickName($folder) $nickname
  117.            return $nickname
  118.         }
  119.      } else {
  120.         # we're new here
  121.         lappend nickNameFolders($nickname) $folder
  122.         foreach clashingFolder $folders {
  123.            catch {unset folderNickName($clashingFolder)}
  124.            Fcache_FolderName $clashingFolder
  125.         }
  126.         return [Fcache_FolderName $folder]
  127.      }
  128.       } else {
  129.      set nickNameFolders($nickname) [list $folder]
  130.      set folderNickName($folder) $nickname
  131.      return $nickname
  132.       }
  133.    }
  134.    set folderNickName($folder) $folder
  135.    return $folder
  136. }
  137. proc Fcache_CreateWindow {} {
  138.     global fdisp fcache
  139.     # Create the canvas for cache display
  140.     set fdisp(cache) [canvas $fdisp(parent).cache -bd 2 -relief raised]
  141.  
  142.     set h [expr {$fcache(lines) * ($fdisp(itemHeight) + $fdisp(ygap)) + $fdisp(ygap)}]
  143.     $fdisp(cache) configure -height $h
  144.  
  145.     pack append $fdisp(parent) $fdisp(cache) {bottom expand fill}
  146.     bind $fdisp(cache) <Configure> {Fcache_Display 1}
  147. }
  148. proc FcacheFixupLines { args } {
  149.     global exwin fcache
  150.     set fcache(enabled) [expr {$fcache(lines) > 0}]
  151.     if !$fcache(enabled) {
  152.     if {$fcache(lastLines) > 0} {
  153.         global fdisp
  154.         catch {
  155.         destroy $fdisp(cache)
  156.         unset fdisp(cache)
  157.         }
  158.     }
  159.     } else {
  160.     global fdisp
  161.     set nodisplay [expr {[string compare $args nodisplay] == 0}]
  162.     if {$fcache(lastLines) == 0 || ![info exists fdisp(cache)]} {
  163.         if {!$nodisplay} {
  164.         Fcache_CreateWindow
  165.         }
  166.     } elseif {$fcache(lastLines) != $fcache(lines)} {
  167.         set h [expr {$fcache(lines) * ($fdisp(itemHeight) + $fdisp(ygap)) + $fdisp(ygap)}]
  168.         $fdisp(cache) configure -height $h
  169.     }
  170.     if {!$nodisplay} {
  171.         if [FcacheLRU] {
  172.         after 1 {Fcache_Display 1}
  173.         }
  174.     }
  175.     }
  176.     set fcache(lastLines) $fcache(lines)
  177. }
  178. proc FcacheFixupSticky { args } {
  179.     global exwin fcache
  180.     set fcache(enabled) [expr {$fcache(lines) > 0}]
  181.     if !$fcache(enabled) {
  182.     return
  183.     } elseif [llength $fcache(sticky)] {
  184.     set fcache(stickyOff) 0
  185.     foreach f $fcache(sticky) {
  186.         Fcache_Folder $f
  187.     }
  188.     } else {
  189.     set fcache(stickyOff) 1
  190.     }
  191. }
  192. proc Fcache_CheckPoint {} {
  193.     global exmh fcache mhProfile
  194.     if [catch {open $mhProfile(path)/.exmhfcache w} out] {
  195.     return
  196.     }
  197.     puts $out [list set fcache(folders) $fcache(folders)]
  198.     puts $out [list set fcache(LRU) $fcache(LRU)]
  199.     close $out
  200. }
  201.  
  202. #### Cache of recently used folder labels
  203.  
  204. proc Fcache_Folder { folder } {
  205.     # Add a folder to the set of cached ones
  206.     global fcache exmh fdisp
  207.     if {$folder == {} || !$fcache(enabled)} {
  208.     return
  209.     }
  210.     foreach pattern $fcache(dontCache) {
  211.        if [string match $pattern $folder] {
  212.       return
  213.        }
  214.     }
  215.     if {$folder == $exmh(folder)} {
  216.     set fdisp(cur,cache) $folder
  217.     }
  218.     if {$folder == $exmh(target)} {
  219.     set fdisp(tar,cache) $folder
  220.     }
  221.     set ix [lsearch $fcache(LRU) $folder]
  222.     if {$ix < 0} {
  223.     Exmh_Debug Fcache_Folder $folder
  224.     if {$fcache(folders) == {}} {
  225.         set fcache(folders) $folder
  226.         set fcache(LRU) $folder
  227.     } else {
  228.         lappend fcache(folders) $folder
  229.         lappend fcache(LRU) $folder
  230.         FcacheLRU
  231.     }
  232.     Fcache_Display
  233.     } else {
  234.     set fcache(LRU) [lreplace $fcache(LRU) $ix $ix]
  235.     lappend fcache(LRU) $folder
  236.     }
  237. }
  238. proc FcacheLRU {} {
  239.     global fcache fdisp
  240.     set changed 0
  241.     while {[Fdisp_Lines $fdisp(cache) $fcache(folders)] > $fcache(lines)} {
  242.     set hit 0
  243.         # first look for a folder that hasn't any unseen msg
  244.         if $fcache(cacheUnseen) {
  245.             foreach f $fcache(LRU) {
  246.                 if {[lsearch $fcache(sticky) $f] < 0
  247.                     && [lsearch [Flist_UnseenFolders] $f] < 0} {
  248.                     set ix [lsearch $fcache(LRU) $f]
  249.                     set fcache(LRU) [lreplace $fcache(LRU) $ix $ix]
  250.                     set ix [lsearch $fcache(folders) $f]
  251.                     set fcache(folders) [lreplace $fcache(folders) $ix $ix]
  252.                     set changed 1 ; set hit 1
  253.                     break
  254.                 }
  255.             }
  256.         }
  257.         # then look for the rest (non-sticky)
  258.         if {! $hit} {
  259.             foreach f $fcache(LRU) {
  260.                 if {[lsearch $fcache(sticky) $f] < 0} {
  261.                     set ix [lsearch $fcache(LRU) $f]
  262.                     set fcache(LRU) [lreplace $fcache(LRU) $ix $ix]
  263.                     set ix [lsearch $fcache(folders) $f]
  264.                     set fcache(folders) [lreplace $fcache(folders) $ix $ix]
  265.                     set changed 1 ; set hit 1
  266.                     break
  267.                 }
  268.             }
  269.             # if really nothing was found to get rid of -> error
  270.             if {! $hit} {
  271.                 # No room to accomodate all sticky folders
  272.                 Exmh_Status "Too many sticky folders for cache"
  273.                 break
  274.             }
  275.         }
  276.     }
  277.     return $changed
  278. }
  279.  
  280. proc Fcache_Display { {force 0} } {
  281.     # Layout the cache of folder buttons
  282.     global fcache
  283.     if {$fcache(enabled)} {
  284.     if {($fcache(folders) != {})} {
  285.         if $fcache(sortByName) {
  286.         set folders $fcache(folders)
  287.         foreach sticky $fcache(sticky) {
  288.             set ix [lsearch $folders $sticky]
  289.             if {$ix >= 0} {
  290.             set folders [lreplace $folders $ix $ix]
  291.             }
  292.         }
  293.         set fcache(folders) [concat $fcache(sticky) [lsort $folders]]
  294.         }
  295.         Fdisp_Layout cache $fcache(folders) {} $force
  296.         Fdisp_HighlightCanvas cache
  297.     }
  298.     }
  299. }
  300. proc Fcache_FolderDiscard { folder } {
  301.     # Remove a folder to the set of cached ones
  302.     global fcache exmh fdisp
  303.     if {$folder == {} || !$fcache(enabled)} {
  304.     return
  305.     }
  306.     if {$folder == $fdisp(cur,cache)} {
  307.     set fdisp(cur,cache) {}
  308.     }
  309.     if {$folder == $fdisp(tar,cache)} {
  310.     set fdisp(tar,cache) {}
  311.     }
  312.     set ix [lsearch $fcache(LRU) $folder]
  313.     if {$ix >= 0} {
  314.     Exmh_Debug Fcache_FolderDisard $folder
  315.     set fcache(LRU) [lreplace $fcache(LRU) $ix $ix]
  316.     set ix [lsearch $fcache(folders) $folder]
  317.     set fcache(folders) [lreplace $fcache(folders) $ix $ix]
  318.     Fcache_Display
  319.     }
  320. }
  321.